Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostuf/pcx256.pas

Pascal/Delphi Source File | 1994-07-25 | 4.1 KB | 237 lines

UNIT PCX256;
{
  Converts a PCX 320*200 pixels picture in 256 colours to
  a raw picture

  THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  E-MAIL ME AT: [e-mail] IN 1994 FOR CHAT AND CODE.
}

INTERFACE

uses
    DEMOINIT;

type
    filenamestring = string[40];

var
    cmap : array[1..256*3] of byte;


procedure LoadPix(buffer : pScreen; filename : filenamestring);
procedure SetCMAP;
procedure Copy2Screen(v : pScreen; s : pScreen);
procedure Copy2TweakScreen(v : pScreen; s : pScreen);
procedure MakeTweak(scr1,scr2 : pScreen);
procedure FadeCMAP(faktor : integer);

(*--------------------------------------*)

IMPLEMENTATION

type
    pBuffer = ^buffertype;
    buffertype = array[1..64000] of byte;

    pHeader = ^HeaderType;
    HeaderType = RECORD
        id : byte;
        ver : byte;
        compressed : boolean;
        bitpixel : byte;
        minx,miny,maxx,maxy : word;
        xsize,ysize : word;
        palette : array[1..48] of byte;
        unknown : byte;
        depth : byte;
        width : word;
        palette_type : word;
        filler : array[1..58] of byte;
    end;


procedure extractCMAP(v : pBuffer; size : longint);
var
    r,g,b : byte;
    i,j,k : word;
begin
    i:=size-(256*3)+1;
    k:=1;
    for j:=1 to 256 do begin
        r:=v^[i] div 4; g:=v^[i+1] div 4; b:=v^[i+2] div 4;
        inc(i,3);
        cmap[k]:=r; cmap[k+1]:=g; cmap[k+2]:=b;
        inc(k,3);
    end;
end;


procedure DecompressPCX(p : pScreen; v : pBuffer; h : pHeader);
var
    xsize, ysize : integer;
begin

    xsize:=h^.xsize;
    for ysize:=1 to h^.ysize do
    asm
        push    ds
        lds    si,v
        les    di,p
@bigloop:
        xor    bx,bx
        xor    cx,cx
        mov    dl,$C0
        mov    dh,$3F
@loop:
        lodsb
        mov    cl,1
        mov    ah,al
        and    ah,dl
        cmp    ah,dl
        jne    @copy
        and    al,dh
        mov    cl,al
        lodsb
@copy:
        add    bx,cx
        rep stosb
        cmp    bx,xsize
        jb        @loop
        pop    ds
        mov    WORD PTR v,si
        mov    ax,xsize
        add    WORD PTR p,ax
    end;
end;

procedure ConvertPCX(p : pScreen; v : pBuffer; size : longint);
var
    h : pHeader;
    i : longint;
begin
    h := pHeader(v);
    with h^ do begin
        if (id<>$0A) OR (NOT compressed) then exit;
        if (bitpixel<>8) OR (depth<>$01) then exit;
    end;
    extractCMAP(v, size);
    if (h^.ver=$05) then decompressPCX(p,@v^[129],h);
end;


procedure LoadPix(buffer : pScreen; filename : filenamestring);
var
    pFileMem: pBuffer;
    FileHandle : file;
    size : longint;
begin
    {$I-}
    Assign(FileHandle, filename);
    Reset(FileHandle, 1);
    {$I+}
    if (IOresult<>0) then halt;
    size := filesize(FileHandle);
    GetMem(pFileMem, size);
    BlockRead(FileHandle, pFileMem^, size);
    Close(FileHandle);
    ConvertPCX(buffer, pFileMem, size);
    FreeMem(pFileMem, size);
end;


(*--------------------------------------*)

procedure SetCMAP;
var
    i,j : integer;
begin
    j:=1;
    for i:=0 to 255 do begin
        SetRGB(i,cmap[j],cmap[j+1],cmap[j+2]);
        inc(j,3);
    end;
end;

procedure Copy2Screen(v : pScreen; s : pScreen); assembler;
asm
    push    ds
    lds    si,v
    les    di,s
    cld
    mov    cx,320*200/2
    rep movsw
    pop    ds
end;


procedure Copy2TweakScreen(v : pScreen; s : pScreen);
const
    size = 80*200;
    procedure CopyPlane(v : pScreen; s : pScreen); assembler;
    asm
        push    ds
        lds    si,v
        les    di,s
        cld
        mov    cx,size/2
        rep movsw
        pop    ds
    end;
begin
    SetBitplanes(1);
    CopyPlane(@v^[0],s);
    SetBitplanes(2);
    CopyPlane(@v^[size+0],s);
    SetBitplanes(4);
    CopyPlane(@v^[size*2+0],s);
    SetBitplanes(8);
    CopyPlane(@v^[size*3+0],s);
end;


procedure MakeTweak(scr1,scr2 : pScreen);
var
    i,scroffset : integer;
begin
    scroffset:=0;
    for i:=0 to 3 do begin
        SetBitplanes(1 shl i);
        asm
            push    ds
            lds    si,scr1
            les    di,scr2
            add    si,i
            add    di,scroffset
            mov    cx,80*200
            mov    dx,4
            cld
@loop1:    mov    al,[si]
            stosb
            add    si,dx
            loop    @loop1
            pop    ds
        end;
        inc(scroffset,80*200);
    end;
end;

procedure FadeCMAP(faktor : integer);
var
    i,j : integer;
begin
    VBLANK;
    j:=1;
    for i:=0 to 255 do begin
        SetRGB(i,
                longmul(cmap[j],faktor) shr 8,
                longmul(cmap[j+1],faktor) shr 8,
                longmul(cmap[j+2],faktor) shr 8);
        inc(j,3);
    end;
end;


end.